home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / 4dos / 4utilsf.zip / 4FF.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-10  |  14KB  |  421 lines
  1. PROGRAM FileFind;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 16384,0,65530}
  4. (* ----------------------------------------------------------------------
  5.    A 4DOS-aware file finder. It searches in .LZH archives too.
  6.  
  7.    (c) 1992 Copyright by David Frey,
  8.                          Urdorferstrasse 30
  9.                          8952 Schlieren ZH
  10.                          Switzerland
  11.  
  12.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  13.  
  14.    DISCLAIMER:   This program is freeware: you are allowed to use, copy
  15.                  and change it free of charge, but you may not sell or hire
  16.                  4FF. The copyright remains in my hands.
  17.  
  18.                  If you make any (considerable) changes to the source code,
  19.                  please let me know. (send me a copy or a listing).
  20.                  I would like to see what you have done.
  21.  
  22.                  I, David Frey, the author, provide absolutely no warranty of
  23.                  any kind. The user of this software takes the entire risk of
  24.                  damages, failures, data losses or other incidents.
  25.  
  26.                  Commercial use of 4DESC or 4FF needs a written consent of
  27.                  the authors.
  28.  
  29.    NOTES:        Turbo Pascal 6.0 required for compiling. (sorry, but I'm
  30.                  using FormatStr for output)
  31.  
  32.    ENHANCEMENTS: adapted to 4DOS 4.01 - when redirecting into files,
  33.                  full descriptions will be shown, otherwise the
  34.                  descriptions will be truncated at the right screen margin.
  35.  
  36.  
  37.    ----------------------------------------------------------------------- *)
  38.  
  39. USES Objects, Drivers,
  40.      Dos, StringDateHandling, HandleINIFile,
  41.      ScanLZHFiles, ScanZIPFiles, Globals;
  42.  
  43. CONST Header= '4FF 4DOS File Find 1.51 -- (c) David Frey 1992';
  44.  
  45. VAR   DescBuffer: ARRAY[0..512] OF CHAR;
  46.  
  47. VAR   ActDir, StartDir            : STRING;
  48.  
  49.       DescArray                   : DescArrayType;
  50.       FileSpecArray               : FileSpecArrayType;
  51.  
  52.       DescFile                    : TEXT;
  53.       DescLine                    : STRING;
  54.       DescLineNr                  : WORD;
  55.       Desc                        : DescStr;
  56.       DescStart                   : BYTE;
  57.       DescEnd                     : BYTE;
  58.       DescFound                   : BOOLEAN;
  59.  
  60.       i,l                         : WORD;
  61.       k                           : BYTE;
  62.       FileSpecs                   : BYTE;
  63.       ps,fs                       : STRING;
  64.       IORes                       : INTEGER;
  65.  
  66.       Templ                       : STRING;
  67.  
  68.       Redir                       : STRING[4];
  69.  
  70.       OldCtrlBreakHandler         : POINTER;
  71.       OldCtrlBreakState           : BOOLEAN;
  72.       BrokeOut                    : BOOLEAN;
  73.  
  74. PROCEDURE MyCtrlBreakHandler; FAR;
  75.  
  76. BEGIN
  77.  ExitProc := OldCtrlBreakHandler; SetCBreak(OldCtrlBreakState);
  78.  {$I-}
  79.  ChDir(ActDir); IORes := IOResult;
  80.  IF BrokeOut THEN
  81.   BEGIN
  82.    WriteLn(Output);
  83.    WriteLn(Output,' EXITING - User broke out of program.');
  84.    WriteLn(Output);
  85.   END;
  86. END;
  87.  
  88. PROCEDURE ShowFileData(VAR search: SearchRec;VAR Path: PathStr;VAR Desc: DescStr);
  89.  
  90. VAR i       : INTEGER;
  91.  
  92. BEGIN
  93.  IF BareOutput THEN
  94.   Write(Output,Path,Search.Name,' ')
  95.  ELSE
  96.   BEGIN
  97.    IF FileCount = 0 THEN
  98.     BEGIN
  99.      WriteLn(Output);
  100.      WriteLn(Output,Path);
  101.     END;
  102.  
  103.    InfoArray[0] := LONGINT(@search.Name);
  104.  
  105.    SizeStr := FormattedLongIntStr(search.Size,7);
  106.    InfoArray[1] := LONGINT(@SizeStr);
  107.  
  108.    UnpackTime(search.Time,DateRec);
  109.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  110.    InfoArray[2] := LONGINT(@Date);
  111.    InfoArray[3] := LONGINT(@Time);
  112.  
  113.    AttrStr := '....';
  114.    IF search.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  115.    IF search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  116.    IF search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  117.    IF search.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  118.    InfoArray[4] := LONGINT(@AttrStr);
  119.    InfoArray[5] := LONGINT(@Desc);
  120.  
  121.    FormatStr(s,'%-12s   %7s '+DateTempl+' '+TimeTempl+' %4s '+DescTempl,InfoArray);
  122.    WriteLn(Output,s);
  123.  
  124.    INC(TotalSize,Search.Size); INC(DirSize,Search.Size);
  125.    INC(TotalFileCount); INC(FileCount);
  126.   END;
  127. END; (* ShowFileData *)
  128.  
  129. PROCEDURE BuildList(Dir: DirStr; VAR FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  130.                     Attr: BYTE);
  131.  
  132. VAR Search: SearchRec;
  133.     DescFileExists: BOOLEAN;
  134.     l,i,k         : BYTE;
  135.  
  136. BEGIN (* BuildList *)
  137.  FileCount := 0; DirSize := 0;
  138.  Attr := Attr AND NOT Directory AND NOT VolumeId;
  139.  OldLHFileName := ''; OldZipFileName := '';
  140.  
  141.  l := Length(Dir); s := Dir;
  142.  IF (l>3) AND (s[l] = '\') THEN Delete(s,l,1);
  143.  ChDir(s);
  144.  
  145.  {$I-}
  146.  Assign(DescFile,'DESCRIPT.ION'); SetTextBuf(DescFile,DescBuffer);
  147.  Reset(DescFile);
  148.  DescFileExists := (IOResult = 0);
  149.  IF DescFileExists THEN
  150.   BEGIN
  151.    DescLineNr := 1;
  152.    WHILE NOT Eof(DescFile) AND (DescLineNr <= MaxComments) DO
  153.     BEGIN
  154.      ReadLn(DescFile,DescLine); DescStart := Pos(' ',DescLine);
  155.      DescEnd := Pos(#4,DescLine); IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  156.       Desc := Copy(DescLine,DescStart+1,DescEnd-1);
  157.      StripLeadingSpaces(Desc);
  158.      i := 1; l := Length(DescLine);
  159.      REPEAT
  160.       IF (DescLine[i] >= 'A') AND (DescLine[i] <= 'Z') THEN
  161.        BEGIN DescLine[i] := Char(Ord(DescLine[i])+32); END;
  162.       INC(i);
  163.      UNTIL (i=l) OR (DescLine[i] = ' ');
  164.      DescArray[DescLineNr] := DescLine; INC(DescLineNr);
  165.     END;
  166.    DEC(DescLineNr);
  167.    IF DescLineNr = MaxComments THEN
  168.     BEGIN
  169.      WriteLn(Output);
  170.      WriteLn(Output,'WARNING: description line buffer full, some comments may not appear.');
  171.      WriteLn(Output);
  172.     END;
  173.    {$I-}
  174.    Close(DescFile); IORes := IOResult;
  175.   END;
  176.  
  177.  IF DoScanLZHArchives THEN
  178.   BEGIN
  179.    FindFirst('????????.LZH',ReadOnly+Archive,Search);
  180.    WHILE DosError = 0 DO
  181.     BEGIN
  182.      SearchInLZHFile(FileSpec,FileSpecs,Dir,Search);
  183.      FindNext(Search);
  184.     END;
  185.   END;
  186.  IF DoScanZIPArchives THEN
  187.   BEGIN
  188.    FindFirst('????????.ZIP',ReadOnly+Archive,Search);
  189.    WHILE DosError = 0 DO
  190.     BEGIN
  191.      SearchInZIPFile(FileSpec,FileSpecs,Dir,Search);
  192.      FindNext(Search);
  193.     END;
  194.   END;
  195.  
  196.  FOR k := 1 TO FileSpecs DO
  197.   BEGIN
  198.    FindFirst(FileSpec[k], Attr, Search);
  199.    WHILE DosError = 0 DO
  200.     BEGIN
  201.      IF NOT ExactAttr OR (ExactAttr AND (Search.Attr = Attr)) THEN
  202.       BEGIN
  203.        DownString(Search.Name);
  204.        Desc := '';
  205.        IF (NOT DescFileExists OR (Search.Name = 'descript.ion')) THEN
  206.         ShowFileData(search,Dir,Desc)
  207.        ELSE
  208.         BEGIN
  209.          i := 1;
  210.          REPEAT
  211.           DescStart := Pos(' ',DescArray[i]);
  212.           DescFound := (Copy(DescArray[i],1,DescStart-1) = Search.Name);
  213.           IF NOT DescFound THEN INC(i);
  214.          UNTIL  DescFound OR (i>DescLineNr);
  215.          IF NOT DescFound THEN Desc := ''
  216.                           ELSE Desc := Copy(DescArray[i],DescStart+1,255);
  217.          ShowFileData(search,Dir,Desc);
  218.         END;
  219.       END;
  220.      FindNext(Search);
  221.     END;
  222.   END;
  223.  
  224.  IF NOT BareOutput AND (FileCount > 0) THEN
  225.   BEGIN
  226.    Templ := '%-4s entr';
  227.    IF TotalFileCount = 1 THEN Templ := Templ + 'y,  '
  228.                          ELSE Templ := Templ + 'ies,';
  229.    Templ := Templ+'  %7s Bytes';
  230.  
  231.    FileStr := FormattedIntStr(FileCount,4);  InfoArray[0] := LONGINT(@FileStr);
  232.    SizeStr := FormattedLongIntStr(DirSize,7);InfoArray[1] := LONGINT(@SizeStr);
  233.    FormatStr(s,Templ,InfoArray);
  234.    WriteLn(Output,s);
  235.   END;
  236.  
  237.  FindFirst('????????. ',Directory, Search);
  238.  WHILE DosError = 0 DO
  239.   BEGIN
  240.    IF (Search.Attr = Directory) AND
  241.       (Search.Name <> '.') AND (Search.Name <> '..') THEN
  242.     BuildList(Dir+Search.Name+'\',FileSpec,FileSpecs,Attr);
  243.    FindNext(Search);
  244.   END;
  245.  {$I-}
  246.  ChDir('..'); IORes := IOResult;
  247. END; (* BuildList *)
  248.  
  249.  
  250. FUNCTION DriveValid(C: CHAR): BOOLEAN; ASSEMBLER;
  251. ASM
  252.   MOV   DL,C
  253.   MOV   AH,36H
  254.   SUB   DL,'A'-1
  255.   Int   21H
  256.   INC   AX
  257.   JE    @@2
  258. @@1:
  259.   MOV   AL,1
  260. @@2:
  261. END; (* DriveValid *)
  262.  
  263. PROCEDURE GiveHelp;
  264.  
  265. BEGIN
  266.  WriteLn(Output);
  267.  WriteLn(Output,Header);
  268.  WriteLn(Output);
  269.  WriteLn(Output,'This program is freeware: you are allowed to use, copy it free');
  270.  WriteLn(Output,'of charge, but you may not sell or hire 4FF.');
  271.  WriteLn(Output);
  272.  WriteLn(Output,'usage: 4FF [/a:[-]rash][/l][/z][/s][/b][/d][/m:nn][/?] [start dir] {filenames}');
  273.  WriteLn(Output);
  274.  WriteLn(Output,' /a:rash search for files with these attributes set.');
  275.  WriteLn(Output,' /l      do not search in .lzh archive files.');
  276.  WriteLn(Output,' /z      do not search in .zip archive files.');
  277.  WriteLn(Output,' /s      scan only subdirectories of given path `start-dir''');
  278.  WriteLn(Output,' /b      bare listing (omits size, date, and descriptions)');
  279.  WriteLn(Output,' /d      scan all hard disks (address floppy drives explicitely)');
  280.  WriteLn(Output,' /m:nn   set right margin to nn');
  281.  WriteLn(Output,' /?      this help display.');
  282.  HALT;
  283. END; (* GiveHelp *)
  284.  
  285. BEGIN
  286.  GetCBreak(OldCtrlBreakState); SetCBreak(FALSE);
  287.  OldCtrlBreakHandler := ExitProc; ExitProc := @MyCtrlBreakHandler;
  288.  BrokeOut := FALSE;
  289.  
  290.  Assign(Output,''); Rewrite(Output);
  291.  
  292.  GetDir(0,ActDir);
  293.  
  294.  IF (ParamStr(1) = '/?') OR (ParamStr(1) = '-?') THEN GiveHelp;
  295.  
  296.  IF TextRec(Output).Name[0] <> #0 THEN
  297.   BEGIN
  298.    MaxViewLength := DescLen;
  299.    Str(MaxViewLength,DescTempl); DescTempl := '%-'+DescTempl+'s';
  300.   END;
  301.  
  302.  BareOutput     := FALSE; ExactAttr  := FALSE;
  303.  SubDirectories := FALSE; AllDrives  := FALSE;
  304.  DoScanLZHArchives := TRUE; DoScanZIPArchives := TRUE;
  305.  FileSpecArray[1] := '*.*'; FileSpecs := 1; StartDir := '';
  306.  
  307.  i := 1; l := 0;
  308.  REPEAT
  309.   ps := ParamStr(i);
  310.   IF ps[1] = '/' THEN ps[1] := '-';
  311.   IF ps[1] = '-' THEN
  312.    BEGIN
  313.     s := Copy(ps,2,255); DownString(s);
  314.  
  315.     IF DoScanLZHArchives     THEN DoScanLZHArchives := (s <>'l');
  316.     IF DoScanZIPArchives     THEN DoScanZIPArchives := (s <>'z');
  317.     IF NOT SubDirectories    THEN SubDirectories    := (s='s');
  318.     IF NOT BareOutput        THEN BareOutput        := (s='b');
  319.     IF NOT AllDrives         THEN AllDrives         := (s='d');
  320.  
  321.     IF s[1] = 'a' THEN
  322.      BEGIN
  323.       s := Copy(s,Pos(':',s)+1,255);
  324.       Attr := 0; AttrStr := '....'; ExactAttr := TRUE;
  325.  
  326.       IF (Pos('r',s) > 0) AND (Pos('-r',s) = 0) THEN BEGIN INC(Attr,ReadOnly); AttrStr[1] := 'r'; END;
  327.       IF (Pos('h',s) > 0) AND (Pos('-h',s) = 0) THEN BEGIN INC(Attr,Hidden  ); AttrStr[2] := 'h'; END;
  328.       IF (Pos('s',s) > 0) AND (Pos('-s',s) = 0) THEN BEGIN INC(Attr,SysFile ); AttrStr[3] := 's'; END;
  329.       IF (Pos('a',s) > 0) AND (Pos('-a',s) = 0) THEN BEGIN INC(Attr,Archive ); AttrStr[4] := 'a'; END;
  330.      END;
  331.  
  332.     IF ps[2] = 'm' THEN
  333.      BEGIN
  334.       Delete(ps,1,3); Val(ps,k,IORes);
  335.       MaxViewLength := k-30-Length(DateFormat)-Length(TimeFormat);
  336.       Str(MaxViewLength,DescTempl); DescTempl := '%-'+DescTempl+'s';
  337.      END;
  338.     INC(l);
  339.    END;
  340.    INC(i);
  341.   UNTIL (i>ParamCount) OR (ps[1] <> '-');
  342.  
  343.  IF l < ParamCount THEN
  344.   BEGIN
  345.    FOR i := l+1 TO ParamCount DO
  346.     BEGIN
  347.      FSplit(FExpand(ParamStr(i)),Path,Name,Ext);
  348.      IF (Path <> '') AND (StartDir = '') THEN StartDir := Path;
  349.      IF Name = '' THEN Name := '*';
  350.      IF Ext  = '' THEN Ext  := '.*';
  351.  
  352.      FileSpecArray[i-l] := Name+Ext; DownString(FileSpecArray[i-l]);
  353.     END;
  354.     FileSpecs := ParamCount-l;
  355.   END;
  356.  
  357.  IF StartDir = ''  THEN StartDir := ActDir;
  358.  IF SubDirectories THEN Path := StartDir
  359.                    ELSE Path := Copy(StartDir,1,3);
  360.  
  361.  IF NOT BareOutput THEN
  362.   BEGIN
  363.    WriteLn(Output,Header);
  364.    WriteLn(Output);
  365.    WriteLn(Output,'This program is freeware: you are allowed to use,');
  366.    WriteLn(Output,'copy it free of charge, but you may not sell or hire 4FF.');
  367.    WriteLn(Output);
  368.    IF FileSpecs = 1 THEN WriteLn(Output,'Filename  = ',FileSpecArray[1],'.')
  369.    ELSE
  370.     BEGIN
  371.      Write  (Output, 'Filenames = ');
  372.      FOR i := 1 TO FileSpecs DO
  373.       BEGIN
  374.        Write(Output,FileSpecArray[i]);
  375.        IF i < FileSpecs THEN Write(Output,', ')
  376.                         ELSE WriteLn(Output,'.');
  377.       END;
  378.     END;
  379.    IF AllDrives THEN WriteLn(Output,'Scanning all drives.')
  380.                 ELSE WriteLn(Output,'Path      = ',Path);
  381.    IF ExactAttr THEN WriteLn(Output,'Attributes= ',AttrStr);
  382.   END;
  383.  
  384.  IF DoScanLZHArchives OR DoScanZIPArchives THEN InstallLZHBuffer;
  385.  
  386.  TotalFileCount := 0; TotalSize := 0; BrokeOut := TRUE;
  387.  
  388.  IF NOT AllDrives THEN
  389.   BEGIN
  390.    s := Path; l := Length(s);
  391.    IF (l > 3) AND (s[l] = '\') THEN Delete(s,l,1);
  392.    BuildList(Path,FileSpecArray,FileSpecs,Attr)
  393.   END
  394.  ELSE
  395.   FOR Drive := 'C' TO 'Z' DO
  396.    IF DriveValid(Drive) THEN BuildList(Drive+':\',FileSpecArray,FileSpecs,Attr);
  397.  BrokeOut := FALSE;
  398.  
  399.  IF NOT BareOutput THEN
  400.   BEGIN
  401.    IF TotalFileCount = 0 THEN s := 'no files found.'
  402.    ELSE
  403.     BEGIN
  404.      Templ := '%s file';
  405.      IF TotalFileCount = 1 THEN Templ := Templ +', '
  406.                            ELSE Templ := Templ +'s,';
  407.      Templ := Templ+'  %9s Bytes';
  408.  
  409.      FileStr := FormattedIntStr(TotalFileCount,4); InfoArray[0] := LONGINT(@FileStr);
  410.      SizeStr := FormattedLongIntStr(TotalSize,9);  InfoArray[1] := LONGINT(@SizeStr);
  411.      FormatStr(s,Templ,InfoArray);
  412.     END;
  413.  
  414.    WriteLn(Output,'------------------------------------------------');
  415.    WriteLn(Output,s);
  416.   END
  417.  ELSE WriteLn(Output);
  418.  
  419.  IF DoScanLZHArchives OR DoScanZIPArchives THEN FreeLZHBuffer;
  420. END.
  421.